home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / exarray.com / EXTBUFF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-08-19  |  2.7 KB  |  126 lines
  1. Unit ExtBuff;
  2. {$R-,S-,O+}
  3.  
  4.           { Defines the ExtendedBuffer Object, which is a file-based
  5.                   storage space for ExtendedArray "Lobes". }
  6.  
  7. { ExtendedBuffers either have the tagged block of data currently
  8.   residing within them, or can access it by reading from the disk
  9.   (after writing any currently contained data to disk).           }
  10.  
  11. INTERFACE
  12.  
  13. Uses XGlobals,FlexPntr;
  14.  
  15. Type
  16.   ExtendedBuffer = Object
  17.  
  18.             Tag       : Short;
  19.             E         : Ext;
  20.             Length    : Word;
  21.             DataField : FlexPtr;
  22.  
  23.             Procedure Create;
  24.             Procedure Init (FName : Short; Exten : Ext; FieldSize : Word);
  25.  
  26.             Procedure SwapData (NewTag : Short);
  27.  
  28.             Function Data : FlexPtr;
  29.             Procedure Accept (Var Info : FlexPtr);  {Changes current Data}
  30.  
  31.             Procedure Destroy;
  32.  
  33.           End;
  34.  
  35. IMPLEMENTATION
  36.  
  37. Procedure Error (Num : Byte);
  38. Begin
  39.   WriteLn;
  40.   Write ('ExtendedBuffer ERROR: ');
  41.   Case Num of
  42.             0 : WriteLn ('Attempted Init on Un-Created or Initialized ExtendedBuffer.');
  43.             1 : WriteLn ('**** OUT OF MEMORY ****');
  44.             2 : WriteLn ('**** Insufficient Disk Space ****');
  45.           End;
  46.   WriteLn ('**** PROGRAM TERMINATED ****');
  47.   WriteLn;
  48.   Write ('Press <Return> to Continue.... ');
  49.   ReadLn;
  50.   HALT (0)
  51. End;
  52.  
  53. Procedure ExtendedBuffer.Create;
  54. Begin
  55.   DataField := Nil
  56. End;
  57.  
  58. Procedure ExtendedBuffer.Init (FName : Short; Exten : Ext; FieldSize : Word);
  59. Begin
  60.   If DataField <> Nil Then Error (0);
  61.   Tag := FName;
  62.   E := Exten;
  63.   Length := FieldSize;
  64.   GetMem (DataField,SizeOf(FlexCount)+FieldSize);
  65.   If DataField = Nil Then Error (1)
  66. End;
  67.  
  68. Procedure Update (E : ExtendedBuffer);
  69. Var
  70.   F : File;
  71. Begin
  72.   Assign (F,E.Tag+E.E);
  73.   {$I-} Rewrite (F,1); {$I+}
  74.   If IOResult <> 0 Then
  75.     Begin
  76.       E.Destroy;
  77.       Error (2)
  78.     End;
  79.   BlockWrite (F,E.DataField^,E.Length+SizeOf(FlexCount));
  80.   Close (F)
  81. End;
  82.  
  83. Procedure Retrieve (E : ExtendedBuffer);
  84. Var
  85.   F : File;
  86. Begin
  87.   Assign (F,E.Tag+E.E);
  88.   {$I-} Reset (F,1); {$I+}
  89.   If IOResult = 0
  90.     Then
  91.       Begin
  92.         BlockRead (F,E.DataField^,E.Length+SizeOf(FlexCount));
  93.         Close (F)
  94.       End
  95. End;
  96.  
  97. Procedure ExtendedBuffer.SwapData (NewTag : Short);
  98. Begin
  99.   Update (Self);
  100.   Tag := NewTag;
  101.   Retrieve (Self)
  102. End;
  103.  
  104. Procedure ExtendedBuffer.Destroy;
  105. Begin
  106.   FreeMem (DataField,Length+SizeOf(FlexCount));
  107.   DataField := Nil;
  108.   Tag := '';
  109.   E := '';
  110.   Length := 0
  111. End;
  112.  
  113. Function ExtendedBuffer.Data;
  114. Begin
  115.   Data := DataField
  116. End;
  117.  
  118. Procedure ExtendedBuffer.Accept;
  119. Begin
  120.   DataField := Info
  121. End;
  122.  
  123. BEGIN
  124.   HeapError := @HeapErrorTrap;
  125.   System.FileMode := 2
  126. END.